home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / PROFILE.ICN < prev    next >
Text File  |  1992-11-20  |  10KB  |  378 lines
  1. ############################################################################
  2. #
  3. #    File:     profile.icn
  4. #
  5. #    Subject:  Program to profile Icon programs
  6. #
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     September 14, 1992
  10. #
  11. ###########################################################################
  12. #
  13. #    Version:  1.3
  14. #
  15. ###########################################################################
  16. #
  17. #  This very simple profiler takes a single argument - an Icon program
  18. #  compiled with the -t option.  Displays stats on which procedures
  19. #  were called the most often, and from what lines in what files they
  20. #  were called.  Use this program to figure out what procedures are
  21. #  getting worked the hardest and why.  Counts only invocations and
  22. #  resumptions; not suspensions, returns, failures.
  23. #
  24. #  If you are running a program that reads from a file, be sure to
  25. #  protect the redirection symbol from the shell (i.e. "profile
  26. #  'myprog < input'" instead of "profile myprog < input").  If a given
  27. #  program normally reads &input, please redirect stdin to read from
  28. #  another tty than the one you are running profile from.  If you
  29. #  forget to do this, the results might be very interesting....  Also,
  30. #  don't redirect stderr, as this contains the trace that profile will
  31. #  be reading and using to obtain run-time statistics.  Profile
  32. #  automatically redirects stdout to /dev/null.
  33. #
  34. #  Currently runs only under UNIX, but with some tweaking could be
  35. #  made to run elsewhere as well.
  36. #
  37. #  The display should be pretty much self-explanatory.  Filenames and
  38. #  procedures get truncated at nineteen characters (if the display
  39. #  gets too wide, it can become hard to read).  A star is prepended to
  40. #  procedures whose statistics have changed since the last screen
  41. #  update.
  42. #
  43. ############################################################################
  44. #
  45. #  Requires:  co-expressions, keyboard functions, pipes, UNIX
  46. #
  47. ############################################################################
  48. #
  49. #  Links:  itlib (or iolib), iscreen
  50. #
  51. ############################################################################
  52.  
  53. link iscreen, itlib
  54.  
  55. global CM, LI, CO, CE
  56.  
  57. procedure main(a)
  58.  
  59.     local whitespace, firstidchars, idchars, usage, in_data,
  60.     cmd, line, filename, linenum, procname, t, threshhold
  61.  
  62.     whitespace   := '\t '
  63.     firstidchars := &letters ++ '_'
  64.     idchars      := &digits ++ &letters ++ '_'
  65.     usage        := "usage:  profile filename _
  66.              (filename = Icon program compiled with -t option)"
  67.  
  68.     #
  69.     # If called with a program name as the first argument, open it,
  70.     # and pipe the trace output back to this program.  Assume the
  71.     # user knew enough to compile it with the "-t" option.
  72.     #
  73.     if *a > 0 then {
  74.     if find("UNIX", &features) then {
  75.         cmd := ""; every cmd ||:= !a || " "
  76.         if find("2>"|"2>&1", cmd) then
  77.         stop("profile:  Please don't redirect stderr!")
  78.         in_data := open(cmd || " 2>&1 1> /dev/null", "pr") |
  79.         stop("profile:  Can't find or execute ", cmd, ".")
  80.     } else stop("profile:  Your OS is not (yet) supported.")
  81.     }
  82.     else stop(usage)
  83.  
  84.     # clear screen, set up global variables; initialize table
  85.     setup_screen()
  86.     t := table()
  87.  
  88.     threshhold := 0
  89.     while line := read(in_data) do {
  90.     threshhold +:= 1
  91.     #
  92.     # Break each line down into a file name, line number, and
  93.     # procedure name.
  94.     #
  95.     line ? {
  96.         tab(many(whitespace))
  97.         match(":") & next
  98.         { 
  99.         filename := trim(tab(find(":"))) &
  100.           tab(many(whitespace ++ ':')) &
  101.           linenum  := tab(many(&digits)) &
  102.           tab(many(whitespace ++ '|')) &
  103.           procname := tab(any(firstidchars)) || tab(many(idchars))
  104.         } | next
  105.         tab(many(whitespace))
  106.         # Count only invocations and resumptions.
  107.         match("suspended"|"failed"|"returned") & next
  108.     }
  109.  
  110.     #
  111.     # Enter statistics into table.
  112.     #
  113.     /t[procname] := table()
  114.     /t[procname][filename] := table(0)
  115.      t[procname][filename][linenum] +:= 1
  116.  
  117.     #
  118.     # Display stats interactively.
  119.     #
  120.     if threshhold > 50 then {
  121.         threshhold := 0
  122.         display_stats(t)
  123.     }
  124.     }
  125.  
  126.     display_stats(t)
  127.     # Write a nice exit message.
  128.     goodbye()
  129.  
  130. end
  131.  
  132.  
  133. #
  134. # display_stats:  display the information in t interactively
  135. #
  136. procedure display_stats(t)
  137.  
  138.     local l, input, c
  139.     static top, len, firstline
  140.     # sets global variables CM, LI, CO, and CE
  141.     initial {
  142.     top := 1
  143.     # The first line we can write data to on the screen.
  144.     firstline := 3
  145.     len := LI - 4 - firstline
  146.     }
  147.  
  148.     #
  149.     # Structure the information in t into a list.  Note that to obtain
  150.     # the number of procedures, one must divide l in half.
  151.     #
  152.     l := sort_table(t)
  153.  
  154.     #
  155.     # Check for user input.
  156.     #
  157.     while kbhit() do {
  158.     iputs(igoto(CM, 1, LI-1))
  159.     writes("Press j/k/^/$/p/q:  ")
  160.     iputs(CE)
  161.     writes(input := map(getch()))
  162.     case input of {
  163.         # Increase or decrease top by 4; don't go beyond 0 or
  164.         # *l; no even numbers for top (the 4 also must be even).
  165.         "j"    : top := (*l > (top+2) | *l-1)
  166.         "\r"   : top := (*l > (top+2) | *l-1)
  167.         "\n"   : top := (*l > (top+2) | *l-1)
  168.         "k"    : top := (0  < (top-2) | 1)
  169.         "\x02" : top := (0  < (top-4) | 1)
  170.         "\x15": top := (0  < (top-4) | 1)
  171.         " "    : top := (*l > (top+4) | *l-1)
  172.         "\x06" : top := (*l > (top+4) | *l-1)
  173.         "\x04" : top := (*l > (top+4) | *l-1)
  174.         "^"    : top := 1
  175.         "$"    : top := *l-1
  176.         "p"    : {
  177.         iputs(igoto(CM, 1, LI-1))
  178.         writes("Press any key to continue: "); iputs(CE)
  179.         until kbhit() & getch() do delay(500)
  180.         }
  181.             "q"    : goodbye()
  182.             "\x0C" : setup_screen()
  183.         "\x012": setup_screen()
  184.         default: {
  185.         if any(&digits, input) then {
  186.             while c := getche() do {
  187.             if c == ("\n"|"\r") then {
  188.                 if not (input <:= 1) then
  189.                 input +:= input % 2 - 1
  190.                 top := (0  < input | 1)
  191.                 top := (*l > input | *l-1)
  192.                 break
  193.             } else {
  194.                 if any(&digits, c)
  195.                 then input ||:= c & next
  196.                 else break
  197.             }
  198.             }
  199.         }
  200.         }
  201.     }
  202.     iputs(igoto(CM, 1, LI-1))
  203.     writes("Press j/k/^/$/p/q:  ")
  204.     iputs(CE)
  205.     }
  206.  
  207.     #
  208.     # Display the information contained in table t via list l2.
  209.     #
  210.     write_list(l, top, len, firstline)
  211.     return
  212.  
  213. end
  214.  
  215.  
  216. #
  217. # sort_table:  structure the info in t into a list
  218. #
  219. #     What a mess.  T is a table, keys = procedure names, values =
  220. #     another table.  These other tables are tables where keys = file
  221. #     names and values = yet another table.  These yet other tables
  222. #     are structured as follows: keys = line numbers, values = number
  223. #     of invocations.  The idea is to collapse all of these tables
  224. #     into sorted lists, and at the same time count up the total
  225. #     number of invocations for a given procedure name (going through
  226. #     all its invocations at every line in every file).  A new table
  227. #     is then created where keys = procedure names and values = total
  228. #     number of invocations.  Yet another sort is done on the basis of
  229. #     total number of invocations.
  230. #
  231. procedure sort_table(t)
  232.  
  233.     local t2, total_t, k, total, i, l, l2
  234.     static old_totals
  235.     initial old_totals := table()
  236.  
  237.     t2 := copy(t)
  238.     total_t := table()
  239.     every k := key(t2) do {
  240.     t2[k] := sort(t2[k], 3)
  241.     total := 0
  242.     every i := 2 to *t2[k] by 2 do {
  243.         every total +:= !t2[k][i]
  244.         t2[k][i] := sort(t2[k][i], 3)
  245.     }
  246.     insert(total_t, k, total)
  247.     }
  248.     l2 := list(); l := sort(total_t, 4)
  249.     every i := 1 to *l-1 by 2 do {
  250.     push(l2, t2[l[i]])
  251.     if not (total_t[l[i]] <= \old_totals[l[i]]) then
  252.         l[i] := "*" || l[i]
  253.     push(l2, l[i])
  254.     }
  255.  
  256.     old_totals := total_t
  257.     return l2
  258.  
  259. end
  260.  
  261.  
  262. #
  263. # write_list:  write statistics in the upper part of the screen
  264. #
  265. procedure write_list(l, top, len, firstline)
  266.  
  267.     local   i, j, k, z, w
  268.     static  last_i
  269.     #global CM, CE
  270.     initial last_i := 2
  271.  
  272.     # Arg1, l, is a sorted table of sorted tables of sorted tables!
  273.     # Firstline is the first line on the screen we can write data to.
  274.     #
  275.     i := firstline
  276.     iputs(igoto(CM, 1, i)); iputs(CE)
  277.     every j := top to *l by 2 do {
  278.     writes(left(l[j], 19, " "))
  279.     every k := 1 to *l[j+1]-1 by 2 do {
  280.         iputs(igoto(CM, 20, i))
  281.         writes(left(l[j+1][k], 19, " "))
  282.         every z := 1 to *l[j+1][k+1]-1 by 2 do {
  283.         iputs(igoto(CM, 40, i))
  284.         writes(left(l[j+1][k+1][z], 7, " "))
  285.         iputs(igoto(CM, 48, i))
  286.         writes(l[j+1][k+1][z+1])
  287.         if (i +:= 1) > (firstline + len) then
  288.             break break break
  289.         else iputs(igoto(CM, 1, i)) & iputs(CE)
  290.         }
  291.     }
  292.     }
  293.  
  294.     # Clear the remaining lines down to the status line.
  295.     #
  296.     every w := i to last_i do {
  297.     iputs(igoto(CM, 1, w))
  298.     iputs(CE)
  299.     }
  300.     last_i := i
  301.  
  302.     return
  303.  
  304. end
  305.  
  306.  
  307. #
  308. # setup_screen: clear screen, set up status line.
  309. #
  310. procedure setup_screen()
  311.  
  312.     # global CM, LI, CO, CE
  313.     initial {
  314.     CM := getval("cm") |
  315.         stop("setup_screen:  No cm capability!")
  316.     LI := getval("li")
  317.     CO := getval("co")
  318.     CE := getval("ce")
  319.     # UNIX-specific command to disable character echo.
  320.     system("stty -echo")
  321.     }
  322.  
  323.     clear()
  324.     iputs(igoto(CM, 1, 1))
  325.     emphasize()
  326.     writes(left(left("procedure name", 19, " ") ||
  327.         left("source file", 20, " ") ||
  328.         left("line", 8, " ") ||
  329.         "number of invocations/resumptions",
  330.         CO, " "))
  331.     normal()
  332.     status_line("- \"Profile,\" by Richard Goerwitz -")
  333.     iputs(igoto(CM, 1, LI-1))
  334.     writes("J or CR=down; k=up; ^=begin; $=end; p=pause; q=quit: ")
  335.     iputs(CE)
  336.  
  337.     return
  338.  
  339. end
  340.  
  341. #
  342. # goodbye: exit, say something nice
  343. #
  344. procedure goodbye()
  345.  
  346.     # UNIX-specific command.
  347.     system("stty echo")
  348.  
  349.     status_line("- \"Profile,\" by Richard Goerwitz -")
  350.     every boldface() | emphasize() | normal() |
  351.       boldface() | emphasize() | normal()
  352.     do {
  353.     delay(50)
  354.     iputs(igoto(CM, 1, LI-1))
  355.     writes("Hope you enjoyed using profile! ")
  356.     normal(); iputs(CE)
  357.     }
  358.     exit()
  359.  
  360. end
  361.  
  362.  
  363. #
  364. # stop_profile:  graceful exit after error
  365. # 
  366. procedure stop_profile(s)
  367.  
  368.     # UNIX-specific command.
  369.     system("stty echo")
  370.  
  371.     status_line("- \"Profile,\" by Richard Goerwitz -")
  372.     iputs(igoto(CM, 1, LI-1))
  373.     writes(s); iputs(CE)
  374.     iputs(igoto(CM, 1, LI))
  375.     stop()
  376.  
  377. end
  378.